COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C***** WAVES.F4  **************
C00008 ENDMK
C⊗;
C***** WAVES.F4  **************
 
C DISPLAYS WAVES OF .MSB FILES.  LOAD WITH WAVIN.FAI
C GETFIL NOW TAKES 6-LETTER NAMES.  EXTENSION .MSB IS EXPECTED.

	COMMON /JUNPAC/ JUNPAC
	DIMENSION J(1024),I(3),L(0/130),NNX(2)
	DOUBLE PRECISION NM,NMX,NMZ
	EQUIVALENCE (I1,I),(I2,I(2)),(I3,I(3)),(AMP,MAXAMP)
	1 ,(NNX,NM)
	DATA NMX/'          '/
	DATA NMZ/'          '/
	IDEV=5   
C***** 5=TTY, 1=DSK
	LCNT=20
	LEND=130
	KOLD=130
	JUNPAC=0
	JNCX=0
	KCNT=0
	ICNT=0
	TYPE 30
	NNX(2)=' '
	ACCEPT 31,NNX
	IF(NM.EQ.NMZ)NM=NMX
4000	IF(NM.EQ.NMZ)NM='TEST'
	NMX=NM
	CALL GETFIL(NM,M)  
C**** M IS WD CNT.
3000	CALL FASTIN(J,128)
2000	ISR=J(2).AND."777777	
C**** GET RIGHT HALF ONLY
	NCHNS=J(4)
	MAXAMP=J(5)
	IF(MAXAMP.GT.200000)MAXAMP=AMP  
C*** WAS IT FLOATING PT.?
	JUNPAC=J(3).AND."777777
	IBIT=12
	KBIT=3
	IAMP=2080
	JAMP=51
	IF(JUNPAC.EQ.0)GO TO 32
	IBIT=18
	JAMP=3275
	KBIT=2
	IAMP=131000
	IF(MAXAMP.LT.2000)GO TO 32
C???	IF(MAXAMP.GT.500000)MAXAMP=AMP*131000
	IAMP=MAXAMP
	JAMP=IAMP/40	
C***** 'NORMALIZES' LOW AMPL.
32	ISMPLS=(M-128)*KBIT
	DUR=NCHNS*ISR
	DUR=ISMPLS/DUR
1000	TYPE 43,ISMPLS,DUR,ISR,IBIT,NCHNS,MAXAMP
43	FORMAT
	1(' FILE CONTAINS ',I7,' SAMPLES.   DUR = ',F6.2,' SECS.'
	1 ,/,' SRATE = ',I5,'   BITS = ',
	1 I2,',   NCHNS = ',I1,',   MAXAMP = ',I6)
	K40=40
	IFLIP=0
	NCH=1
	IF(NCHNS.LT.2)GO TO 33
	TYPE 34
34	FORMAT(' TYPE CHNL NUM.  '$)
	IFLIP=-1
	ACCEPT 1,NCH
	IF(NCH.EQ.0)NCH=1
	IF(NCH.NE.1)IFLIP=-IFLIP
CC	IF(IFLIP.GT.0)ICNT=-1
33	TYPE 47
	ACCEPT 46,INCX
	IF(INCX.EQ.0)INCX=1
	TYPE 40
	F=0
	ACCEPT 46,ISKP,LAST,NORM
	IF(LAST.EQ.0)LAST = ISKP+500
	IF(LAST.LT.ISKP)LAST=ISKP+LAST
	IF(LAST.GT.ISMPLS)LAST=ISMPLS
50	FORMAT(' <CR>=DPY   F=TO A FILE '$)
51	FORMAT(' <CR>=LPT FORMAT     D=DPY FORMAT '$)
	TYPE 50
	ACCEPT 31,IDSK
	IF(IDSK.NE.'F')GO TO 45
	TYPE 51
	ACCEPT 31,F
	CALL OFILE(1,'WAVES')
	IF(IDSK.NE.'F')GO TO 144
	LCNT=50
	TYPE 44
44	FORMAT(/' WRITING FILE: WAVES.DAT',/,
	1 ' TO STOP: TYPE <CALL>, F <CR>')
144	IDEV=1  
C** FOR DSK OUTPUT.
40	FORMAT(' TYPE SAMPLE NUM.1, NUM2  '$)
1	FORMAT(8I9)
46	FORMAT(8I)
31	FORMAT(2A5)
30	FORMAT(' TYPE FILE NAME  '$)
5	FORMAT(1X80A1)
CC	JAMP=51
	IF(JUNPAC.NE.0)JAMP=1637
45	IF(F.NE.' ')GO TO 102
	JAMP=32
	IF(JUNPAC.NE.0)JAMP=1007
	K40=65
	GO TO 2
CC102	CALL NODM
102	IF(JUNPAC.NE.0)GO TO 2
202	IF(MAXAMP.GT.1900)GO TO 2
	TYPE 103
103	FORMAT(' N=NORMALIZE   '$)
	ACCEPT 31,K
	IF(K.NE.'N')GO TO 2
	IAMP=MAXAMP
	JAMP=IAMP/40
2	CALL FASTIN(J,1024)
	DO 3 K=1,1024
	CALL UNPAC(J(K),I)
	DO 3 JJ=1,KBIT
	IFLIP=-IFLIP
	ICNT=ICNT+1    
	  IF(ICNT.LT.ISKP)GO TO 3
	IF(ICNT.GT.LAST)GO TO 41 
	IF(IFLIP)GO TO 3  
C****** STEREO FLIP-FLOP
	JNCX=JNCX+1
	IF(JNCX.NE.INCX)GO TO 3
	JNCX=0
99	KX=I(JJ)
	KK=(KX+IAMP)/JAMP  
	KF=-1
	KZZ=6
CC	IF(MOD(ICNT,100).NE.0)GO TO 997
	KCNT=KCNT+1
	IF(KCNT.LT.LCNT)GO TO 997
	KCNT=0
	KF=0 
	KZZ=14
997	IF(KOLD.EQ.KK)GO TO 777
	K80=KOLD
	IF(KK.GT.KOLD)K80=KK
	IF(KK.GE.LEND)LEND=K40 
	DO 4 KM=6,LEND
4	L(KM)=' '
400	LEND=KK
	INC=-1
	IF(KK.GE.K40)INC=-INC
	DO 999 KZ=K40,KK,INC
999	L(KZ)='*'
998	KZ=KK  
	KOLD=KK
	IF (KZ.GE.K40)GO TO 777
	KZ=K40
777	IF(KF)GO TO 7
	WRITE(IDEV,106)NNX,ICNT,(L(NN),NN=15,KZ)
	IF(IDEV.EQ.1)TYPE 106,NNX,ICNT  
C***TELL HOW FAR ALONG WE ARE.
	GO TO 3
7	IF(JUNPAC.NE.0)GO TO 778
	WRITE(IDEV,1105)KX,(L(NN),NN=6,KZ)
	GO TO 3
778	WRITE(IDEV,105)KX,(L(NN),NN=9,KZ)
3	CONTINUE 
	GO TO 2
CC41	CALL YESDM
41	STOP
47	FORMAT(' INCREMENT = '$)
105	FORMAT(I9,122A1)
1105	FORMAT(I6,124A1)
106	FORMAT(1XA5,A1,I8,116A1)
	END